home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / src / types.c < prev    next >
Text File  |  1994-01-03  |  49KB  |  2,416 lines
  1. # include "Types.h"
  2. # include "yyTypes.w"
  3. # include <stdio.h>
  4. # if defined __STDC__ | defined __cplusplus
  5. #  include <stdlib.h>
  6. # else
  7.    extern void exit ();
  8. # endif
  9. # include "Tree.h"
  10. # include "Definiti.h"
  11.  
  12. # ifndef NULL
  13. # define NULL 0L
  14. # endif
  15. # ifndef false
  16. # define false 0
  17. # endif
  18. # ifndef true
  19. # define true 1
  20. # endif
  21.  
  22. # ifdef yyInline
  23. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
  24.   if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
  25.   free += nodesize [kind]; \
  26.   ptr->yyHead.yyMark = 0; \
  27.   ptr->Kind = kind;
  28. # else
  29. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
  30. # endif
  31.  
  32. # define yyWrite(s) (void) fputs (s, yyf)
  33. # define yyWriteNl (void) fputc ('\n', yyf)
  34.  
  35. # line 35 "Types.puma"
  36.  
  37. # include "Idents.h"
  38. # include "StringMe.h"
  39.  
  40. # include "protocol.h"
  41.  
  42. # include "ShowDefs.h"   /* error message for definitions */
  43.  
  44.  
  45. static FILE * yyf = stdout;
  46.  
  47. static void yyAbort
  48. # ifdef __cplusplus
  49.  (char * yyFunction)
  50. # else
  51.  (yyFunction) char * yyFunction;
  52. # endif
  53. {
  54.  (void) fprintf (stderr, "Error: module Types, routine %s failed\n", yyFunction);
  55.  exit (1);
  56. }
  57.  
  58. int TreeListLength ARGS((tTree t));
  59. int VarDistribution ARGS((tDefinitions v));
  60. int TreeDistribution ARGS((tTree t));
  61. static int DistributionMerge ARGS((int dist1, int dist2));
  62. bool IsPureObj ARGS((tDefinitions v));
  63. bool IsVarCommon ARGS((tDefinitions v));
  64. bool IsVarDummy ARGS((tDefinitions v));
  65. bool IsVarAllocatable ARGS((tDefinitions v));
  66. static bool IsTreeAllocatable ARGS((tTree t));
  67. bool IsVarOverlapped ARGS((tDefinitions v));
  68. bool IsArrayOverlapped ARGS((tTree t));
  69. bool IsIntrFunc ARGS((tTree t));
  70. int VarRank ARGS((tDefinitions v));
  71. int TreeRank ARGS((tTree t));
  72. static int ParameterRank ARGS((tTree t));
  73. int ParameterVars ARGS((tTree t));
  74. tTree VarType ARGS((tDefinitions v));
  75. tTree TreeType ARGS((tTree t));
  76. int VarSize ARGS((tDefinitions v));
  77. int TreeSize ARGS((tTree t));
  78. static int IntrFuncRank ARGS((tIdent name, tTree param));
  79. static int IntrFuncRedRank ARGS((tTree param));
  80. bool IntrFuncKind1 ARGS((tIdent name));
  81. bool IntrFuncKind2 ARGS((tIdent name));
  82. bool IntrFuncKindn ARGS((tIdent name));
  83. bool IntrFuncRed ARGS((tIdent name));
  84. tTree ArrayCompType ARGS((tDefinitions v));
  85. tTree ArrayFormals ARGS((tDefinitions v));
  86. static bool IsConstExp ARGS((tTree t));
  87. tIdent TreeVarName ARGS((tTree var));
  88. tTree LastIndex ARGS((tTree t));
  89.  
  90. int TreeListLength
  91. # if defined __STDC__ | defined __cplusplus
  92. (register tTree t)
  93. # else
  94. (t)
  95.  register tTree t;
  96. # endif
  97. {
  98. # line 52 "Types.puma"
  99.   {
  100. # line 53 "Types.puma"
  101.    if (! (t == NoTree)) goto yyL1;
  102.   }
  103.    return 0;
  104. yyL1:;
  105.  
  106.  
  107.   switch (t->Kind) {
  108.   case kACF_LIST:
  109. # line 57 "Types.puma"
  110.    return 1 + TreeListLength (t->ACF_LIST.Next);
  111.  
  112.   case kACF_EMPTY:
  113. # line 61 "Types.puma"
  114.    return 0;
  115.  
  116.   case kBTE_LIST:
  117. # line 65 "Types.puma"
  118.    return (1 + TreeListLength (t->BTE_LIST.Next));
  119.  
  120.   case kBTE_EMPTY:
  121. # line 69 "Types.puma"
  122.    return 0;
  123.  
  124.   case kBTV_LIST:
  125. # line 73 "Types.puma"
  126.    return (1 + TreeListLength (t->BTV_LIST.Next));
  127.  
  128.   case kBTV_EMPTY:
  129. # line 77 "Types.puma"
  130.    return 0;
  131.  
  132.   case kBTP_LIST:
  133. # line 81 "Types.puma"
  134.    return (1 + TreeListLength (t->BTP_LIST.Next));
  135.  
  136.   case kBTP_EMPTY:
  137. # line 85 "Types.puma"
  138.    return 0;
  139.  
  140.   case kTYPE_LIST:
  141. # line 89 "Types.puma"
  142.    return (1 + TreeListLength (t->TYPE_LIST.Next));
  143.  
  144.   case kTYPE_EMPTY:
  145. # line 93 "Types.puma"
  146.    return 0;
  147.  
  148.   case kDECL_LIST:
  149. # line 97 "Types.puma"
  150.    return (1 + TreeListLength (t->DECL_LIST.Next));
  151.  
  152.   case kDECL_EMPTY:
  153. # line 101 "Types.puma"
  154.    return 0;
  155.  
  156.   case kDIST_LIST:
  157. # line 105 "Types.puma"
  158.    return (1 + TreeListLength (t->DIST_LIST.Next));
  159.  
  160.   case kDIST_EMPTY:
  161. # line 109 "Types.puma"
  162.    return 0;
  163.  
  164.   }
  165.  
  166. # line 113 "Types.puma"
  167.   {
  168. # line 114 "Types.puma"
  169.    printf ("Illegal Tree in TreeListLength\n");
  170. # line 115 "Types.puma"
  171.    WriteTree (stdout, t);
  172.   }
  173.    return 0;
  174.  
  175. }
  176.  
  177. int VarDistribution
  178. # if defined __STDC__ | defined __cplusplus
  179. (register tDefinitions v)
  180. # else
  181. (v)
  182.  register tDefinitions v;
  183. # endif
  184. {
  185. # line 133 "Types.puma"
  186.  
  187. char string[100];
  188.  
  189. # line 137 "Types.puma"
  190.   {
  191. # line 138 "Types.puma"
  192.    if (! ((v == NoObject))) goto yyL1;
  193.   {
  194. # line 139 "Types.puma"
  195.    printf ("Call of VarDistribution for NoObject\n");
  196. # line 140 "Types.puma"
  197.    kill_in_protocol ();
  198.   }
  199.   }
  200.    return 0;
  201. yyL1:;
  202.  
  203.   if (v->Kind == kVarObject) {
  204.   if (v->VarObject.Dist->Kind == kHostDistribution) {
  205. # line 144 "Types.puma"
  206.    return - 1;
  207.  
  208.   }
  209.   if (v->VarObject.Dist->Kind == kSerialDistribution) {
  210. # line 148 "Types.puma"
  211.    return 0;
  212.  
  213.   }
  214.   if (v->VarObject.Dist->Kind == kNodeDistribution) {
  215. # line 152 "Types.puma"
  216.    return 1;
  217.  
  218.   }
  219.   }
  220.   if (v->Kind == kProcObject) {
  221. # line 156 "Types.puma"
  222.    return 0;
  223.  
  224.   }
  225.   if (v->Kind == kFuncObject) {
  226.   if (v->FuncObject.decl->Kind == kFUNC_DECL) {
  227. # line 160 "Types.puma"
  228.    return 0;
  229.  
  230.   }
  231.   if (v->FuncObject.decl->Kind == kSTMT_FUNC_DECL) {
  232. # line 165 "Types.puma"
  233.    return 0;
  234.  
  235.   }
  236.   if (v->FuncObject.decl->Kind == kEXT_FUNC_DECL) {
  237. # line 170 "Types.puma"
  238.    return 0;
  239.  
  240.   }
  241.   }
  242.   if (v->Kind == kBlockObject) {
  243. # line 175 "Types.puma"
  244.   {
  245. # line 176 "Types.puma"
  246.    GetString (v->BlockObject.ident, string);
  247. # line 177 "Types.puma"
  248.    printf ("ERROR: VarDistribution for BlockObject %s\n", string);
  249. # line 178 "Types.puma"
  250.    FileUnparse (stdout, v->BlockObject.decl);
  251. # line 179 "Types.puma"
  252.    exit (- 1);
  253.   }
  254.    return 0;
  255.  
  256.   }
  257. # line 183 "Types.puma"
  258.   {
  259. # line 184 "Types.puma"
  260.  GetString (v->Object.ident, string);
  261. # line 185 "Types.puma"
  262.    printf ("Distribution not found for %s\n", string);
  263. # line 186 "Types.puma"
  264.    exit (- 1);
  265.   }
  266.    return 0;
  267.  
  268. }
  269.  
  270. int TreeDistribution
  271. # if defined __STDC__ | defined __cplusplus
  272. (register tTree t)
  273. # else
  274. (t)
  275.  register tTree t;
  276. # endif
  277. {
  278. # line 203 "Types.puma"
  279.  
  280. int r1, r2, r3;
  281.  
  282.  
  283.   switch (t->Kind) {
  284.   case kVAR_OBJ:
  285. # line 207 "Types.puma"
  286.    return VarDistribution (t->VAR_OBJ.Object);
  287.  
  288.   case kUSED_VAR:
  289. # line 211 "Types.puma"
  290.    return TreeDistribution (t->USED_VAR.VARNAME);
  291.  
  292.   case kLOOP_VAR:
  293. # line 215 "Types.puma"
  294.    return 0;
  295.  
  296.   case kINDEXED_VAR:
  297. # line 219 "Types.puma"
  298.   {
  299. # line 220 "Types.puma"
  300.    r1 = TreeDistribution (t->INDEXED_VAR.IND_VAR);
  301. # line 221 "Types.puma"
  302.    r2 = TreeDistribution (t->INDEXED_VAR.IND_EXPS);
  303.   }
  304.    return DistributionMerge (r1, r2);
  305.  
  306.   case kSUBSTRING_VAR:
  307. # line 225 "Types.puma"
  308.    return TreeDistribution (t->SUBSTRING_VAR.IND_VAR);
  309.  
  310.   case kDO_VAR:
  311. # line 229 "Types.puma"
  312.   {
  313. # line 230 "Types.puma"
  314.    r1 = TreeDistribution (t->DO_VAR.RANGE);
  315. # line 231 "Types.puma"
  316.    r2 = TreeDistribution (t->DO_VAR.BODY);
  317. # line 232 "Types.puma"
  318.    r1 = DistributionMerge (r1, r2);
  319.   }
  320.    return r1;
  321.  
  322.   case kBTV_LIST:
  323. # line 236 "Types.puma"
  324.   {
  325. # line 237 "Types.puma"
  326.    r1 = TreeDistribution (t->BTV_LIST.Elem);
  327. # line 238 "Types.puma"
  328.    r2 = TreeDistribution (t->BTV_LIST.Next);
  329.   }
  330.    return DistributionMerge (r1, r2);
  331.  
  332.   case kBTV_EMPTY:
  333. # line 242 "Types.puma"
  334.    return 0;
  335.  
  336.   case kBTE_LIST:
  337. # line 246 "Types.puma"
  338.   {
  339. # line 247 "Types.puma"
  340.    r1 = TreeDistribution (t->BTE_LIST.Elem);
  341. # line 248 "Types.puma"
  342.    r2 = TreeDistribution (t->BTE_LIST.Next);
  343.   }
  344.    return DistributionMerge (r1, r2);
  345.  
  346.   case kBTE_EMPTY:
  347. # line 252 "Types.puma"
  348.    return 0;
  349.  
  350.   case kARRAY_EXP:
  351. # line 256 "Types.puma"
  352.    return TreeDistribution (t->ARRAY_EXP.ELEMENTS);
  353.  
  354.   case kADDR:
  355. # line 260 "Types.puma"
  356.    return TreeDistribution (t->ADDR.E);
  357.  
  358.   case kDUMMY_EXP:
  359. # line 264 "Types.puma"
  360.    return 0;
  361.  
  362.   case kCONST_EXP:
  363. # line 268 "Types.puma"
  364.    return 0;
  365.  
  366.   case kSLICE_EXP:
  367. # line 272 "Types.puma"
  368.   {
  369. # line 273 "Types.puma"
  370.    r1 = TreeDistribution (t->SLICE_EXP.START);
  371. # line 274 "Types.puma"
  372.    r2 = TreeDistribution (t->SLICE_EXP.STOP);
  373. # line 275 "Types.puma"
  374.    r1 = DistributionMerge (r1, r2);
  375. # line 276 "Types.puma"
  376.    r3 = TreeDistribution (t->SLICE_EXP.INC);
  377. # line 277 "Types.puma"
  378.    r1 = DistributionMerge (r1, r2);
  379.   }
  380.    return r1;
  381.  
  382.   case kOP_EXP:
  383. # line 281 "Types.puma"
  384.   {
  385. # line 282 "Types.puma"
  386.    r1 = TreeDistribution (t->OP_EXP.OPND1);
  387. # line 283 "Types.puma"
  388.    r2 = TreeDistribution (t->OP_EXP.OPND2);
  389. # line 284 "Types.puma"
  390.    r1 = DistributionMerge (r1, r2);
  391.   }
  392.    return r1;
  393.  
  394.   case kOP1_EXP:
  395. # line 288 "Types.puma"
  396.    return TreeDistribution (t->OP1_EXP.OPND);
  397.  
  398.   case kVAR_EXP:
  399. # line 292 "Types.puma"
  400.    return TreeDistribution (t->VAR_EXP.V);
  401.  
  402.   case kFUNC_CALL_EXP:
  403. # line 296 "Types.puma"
  404.    return TreeDistribution (t->FUNC_CALL_EXP.FUNC_PARAMS);
  405.  
  406.   case kDO_EXP:
  407. # line 300 "Types.puma"
  408.   {
  409. # line 301 "Types.puma"
  410.    r1 = TreeDistribution (t->DO_EXP.RANGE);
  411. # line 302 "Types.puma"
  412.    r2 = TreeDistribution (t->DO_EXP.BODY);
  413. # line 303 "Types.puma"
  414.    r1 = DistributionMerge (r1, r2);
  415.   }
  416.    return r1;
  417.  
  418.   case kBTP_LIST:
  419. # line 307 "Types.puma"
  420.   {
  421. # line 308 "Types.puma"
  422.    r1 = TreeDistribution (t->BTP_LIST.Elem);
  423. # line 309 "Types.puma"
  424.    r2 = TreeDistribution (t->BTP_LIST.Next);
  425.   }
  426.    return DistributionMerge (r1, r2);
  427.  
  428.   case kBTP_EMPTY:
  429. # line 313 "Types.puma"
  430.    return 0;
  431.  
  432.   case kVAR_PARAM:
  433. # line 317 "Types.puma"
  434.    return TreeDistribution (t->VAR_PARAM.V);
  435.  
  436.   case kPROC_PARAM:
  437. # line 321 "Types.puma"
  438.    return 0;
  439.  
  440.   }
  441.  
  442. # line 325 "Types.puma"
  443.   {
  444. # line 326 "Types.puma"
  445.    printf ("Determination of TreeDistribution (Types.puma) fails\n");
  446. # line 327 "Types.puma"
  447.    FileUnparse (stdout, t);
  448. # line 328 "Types.puma"
  449.    WriteTree (stdout, t);
  450.   }
  451.    return 0;
  452.  
  453. }
  454.  
  455. static int DistributionMerge
  456. # if defined __STDC__ | defined __cplusplus
  457. (register int dist1, register int dist2)
  458. # else
  459. (dist1, dist2)
  460.  register int dist1;
  461.  register int dist2;
  462. # endif
  463. {
  464.   if (equalint (dist2, 0)) {
  465. # line 334 "Types.puma"
  466.    return dist1;
  467.  
  468.   }
  469.   if (equalint (dist1, 0)) {
  470. # line 338 "Types.puma"
  471.    return dist2;
  472.  
  473.   }
  474. # line 342 "Types.puma"
  475.   {
  476. # line 343 "Types.puma"
  477.    if (! (dist1 == dist2)) goto yyL3;
  478.   }
  479.    return dist1;
  480. yyL3:;
  481.  
  482. # line 347 "Types.puma"
  483.    return - 2;
  484.  
  485. }
  486.  
  487. bool IsPureObj
  488. # if defined __STDC__ | defined __cplusplus
  489. (register tDefinitions v)
  490. # else
  491. (v)
  492.  register tDefinitions v;
  493. # endif
  494. {
  495.   if (v == NoDefinitions) return false;
  496. # line 359 "Types.puma"
  497.   {
  498. # line 360 "Types.puma"
  499.    if (! ((v == NoObject))) goto yyL1;
  500.   {
  501. # line 361 "Types.puma"
  502.    printf ("Call of IsPureObj for NoObject\n");
  503. # line 362 "Types.puma"
  504.    kill_in_protocol ();
  505. # line 363 "Types.puma"
  506.    return false;
  507.   }
  508.   }
  509. yyL1:;
  510.  
  511.   if (v->Kind == kFuncObject) {
  512.   if (v->FuncObject.decl->Kind == kFUNC_DECL) {
  513. # line 366 "Types.puma"
  514.   {
  515. # line 368 "Types.puma"
  516.    if (! ((v->FuncObject.decl->FUNC_DECL.IsPure != false))) goto yyL2;
  517.   }
  518.    return true;
  519. yyL2:;
  520.  
  521.   }
  522.   }
  523.   if (v->Kind == kProcObject) {
  524.   if (v->ProcObject.decl->Kind == kPROC_DECL) {
  525. # line 371 "Types.puma"
  526.   {
  527. # line 373 "Types.puma"
  528.    if (! ((v->ProcObject.decl->PROC_DECL.IsPure != false))) goto yyL3;
  529.   }
  530.    return true;
  531. yyL3:;
  532.  
  533.   }
  534.   }
  535.   return false;
  536. }
  537.  
  538. bool IsVarCommon
  539. # if defined __STDC__ | defined __cplusplus
  540. (register tDefinitions v)
  541. # else
  542. (v)
  543.  register tDefinitions v;
  544. # endif
  545. {
  546.   if (v == NoDefinitions) return false;
  547.   if (v->Kind == kVarObject) {
  548.   if (v->VarObject.Kind->Kind == kVarCommon) {
  549. # line 384 "Types.puma"
  550.    return true;
  551.  
  552.   }
  553.   }
  554.   return false;
  555. }
  556.  
  557. bool IsVarDummy
  558. # if defined __STDC__ | defined __cplusplus
  559. (register tDefinitions v)
  560. # else
  561. (v)
  562.  register tDefinitions v;
  563. # endif
  564. {
  565.   if (v == NoDefinitions) return false;
  566.   if (v->Kind == kVarObject) {
  567.   if (v->VarObject.Kind->Kind == kVarDummy) {
  568. # line 389 "Types.puma"
  569.    return true;
  570.  
  571.   }
  572.   }
  573.   return false;
  574. }
  575.  
  576. bool IsVarAllocatable
  577. # if defined __STDC__ | defined __cplusplus
  578. (register tDefinitions v)
  579. # else
  580. (v)
  581.  register tDefinitions v;
  582. # endif
  583. {
  584.   if (v == NoDefinitions) return false;
  585.   if (v->Kind == kVarObject) {
  586.   if (v->VarObject.decl->Kind == kVAR_DECL) {
  587.   if (v->VarObject.Kind->Kind == kVarLocal) {
  588. # line 400 "Types.puma"
  589.   {
  590. # line 401 "Types.puma"
  591.    if (! (IsTreeAllocatable (v->VarObject.decl->VAR_DECL.VAL))) goto yyL1;
  592.   }
  593.    return true;
  594. yyL1:;
  595.  
  596.   }
  597.   if (v->VarObject.Kind->Kind == kVarCommon) {
  598. # line 408 "Types.puma"
  599.   {
  600. # line 409 "Types.puma"
  601.    if (! (IsTreeAllocatable (v->VarObject.decl->VAR_DECL.VAL))) goto yyL3;
  602.   }
  603.    return true;
  604. yyL3:;
  605.  
  606.   }
  607.   }
  608.   if (v->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  609.   if (v->VarObject.Kind->Kind == kVarDummy) {
  610. # line 404 "Types.puma"
  611.   {
  612. # line 405 "Types.puma"
  613.    if (! (IsTreeAllocatable (v->VarObject.decl->VAR_PARAM_DECL.VAL))) goto yyL2;
  614.   }
  615.    return true;
  616. yyL2:;
  617.  
  618.   }
  619.   }
  620.   }
  621.   return false;
  622. }
  623.  
  624. static bool IsTreeAllocatable
  625. # if defined __STDC__ | defined __cplusplus
  626. (register tTree t)
  627. # else
  628. (t)
  629.  register tTree t;
  630. # endif
  631. {
  632.   if (t == NoTree) return false;
  633.   if (t->Kind == kARRAY_TYPE) {
  634. # line 414 "Types.puma"
  635.   {
  636. # line 415 "Types.puma"
  637.    if (! (IsTreeAllocatable (t->ARRAY_TYPE.ARRAY_INDEX_TYPES))) goto yyL1;
  638.   }
  639.    return true;
  640. yyL1:;
  641.  
  642.   }
  643.   if (t->Kind == kTYPE_LIST) {
  644. # line 418 "Types.puma"
  645.   {
  646. # line 419 "Types.puma"
  647.    if (! (IsTreeAllocatable (t->TYPE_LIST.Elem))) goto yyL2;
  648.   {
  649. # line 420 "Types.puma"
  650.    if (! (IsTreeAllocatable (t->TYPE_LIST.Next))) goto yyL2;
  651.   }
  652.   }
  653.    return true;
  654. yyL2:;
  655.  
  656.   }
  657.   if (t->Kind == kTYPE_EMPTY) {
  658. # line 423 "Types.puma"
  659.    return true;
  660.  
  661.   }
  662.   if (t->Kind == kDYNAMIC) {
  663. # line 426 "Types.puma"
  664.    return true;
  665.  
  666.   }
  667.   return false;
  668. }
  669.  
  670. bool IsVarOverlapped
  671. # if defined __STDC__ | defined __cplusplus
  672. (register tDefinitions v)
  673. # else
  674. (v)
  675.  register tDefinitions v;
  676. # endif
  677. {
  678.   if (v == NoDefinitions) return false;
  679.   if (v->Kind == kVarObject) {
  680.   if (v->VarObject.Kind->Kind == kVarLocal) {
  681. # line 437 "Types.puma"
  682.   {
  683. # line 438 "Types.puma"
  684.    if (! (IsArrayOverlapped (v->VarObject.decl))) goto yyL1;
  685.   }
  686.    return true;
  687. yyL1:;
  688.  
  689.   }
  690.   if (v->VarObject.Kind->Kind == kVarDummy) {
  691. # line 441 "Types.puma"
  692.   {
  693. # line 442 "Types.puma"
  694.    if (! (IsArrayOverlapped (v->VarObject.decl))) goto yyL2;
  695.   }
  696.    return true;
  697. yyL2:;
  698.  
  699.   }
  700.   if (v->VarObject.Kind->Kind == kVarCommon) {
  701. # line 445 "Types.puma"
  702.   {
  703. # line 446 "Types.puma"
  704.    if (! (IsArrayOverlapped (v->VarObject.decl))) goto yyL3;
  705.   }
  706.    return true;
  707. yyL3:;
  708.  
  709.   }
  710.   }
  711.   return false;
  712. }
  713.  
  714. bool IsArrayOverlapped
  715. # if defined __STDC__ | defined __cplusplus
  716. (register tTree t)
  717. # else
  718. (t)
  719.  register tTree t;
  720. # endif
  721. {
  722.   if (t == NoTree) return false;
  723.  
  724.   switch (t->Kind) {
  725.   case kVAR_OBJ:
  726. # line 451 "Types.puma"
  727.   {
  728. # line 452 "Types.puma"
  729.    if (! (IsVarOverlapped (t->VAR_OBJ.Object))) goto yyL1;
  730.   }
  731.    return true;
  732. yyL1:;
  733.  
  734.   break;
  735.   case kUSED_VAR:
  736. # line 455 "Types.puma"
  737.   {
  738. # line 456 "Types.puma"
  739.    if (! (IsArrayOverlapped (t->USED_VAR.VARNAME))) goto yyL2;
  740.   }
  741.    return true;
  742. yyL2:;
  743.  
  744.   break;
  745.   case kINDEXED_VAR:
  746. # line 459 "Types.puma"
  747.   {
  748. # line 460 "Types.puma"
  749.    if (! (IsArrayOverlapped (t->INDEXED_VAR.IND_VAR))) goto yyL3;
  750.   }
  751.    return true;
  752. yyL3:;
  753.  
  754.   break;
  755.   case kVAR_DECL:
  756. # line 463 "Types.puma"
  757.   {
  758. # line 464 "Types.puma"
  759.    if (! (IsArrayOverlapped (t->VAR_DECL.VAL))) goto yyL4;
  760.   }
  761.    return true;
  762. yyL4:;
  763.  
  764.   break;
  765.   case kVAR_PARAM_DECL:
  766. # line 467 "Types.puma"
  767.   {
  768. # line 468 "Types.puma"
  769.    if (! (IsArrayOverlapped (t->VAR_PARAM_DECL.VAL))) goto yyL5;
  770.   }
  771.    return true;
  772. yyL5:;
  773.  
  774.   break;
  775.   case kARRAY_TYPE:
  776. # line 471 "Types.puma"
  777.   {
  778. # line 472 "Types.puma"
  779.    if (! (IsArrayOverlapped (t->ARRAY_TYPE.ARRAY_INDEX_TYPES))) goto yyL6;
  780.   }
  781.    return true;
  782. yyL6:;
  783.  
  784.   break;
  785.   case kTYPE_LIST:
  786. # line 475 "Types.puma"
  787.   {
  788. # line 476 "Types.puma"
  789.    if (! (IsArrayOverlapped (t->TYPE_LIST.Elem))) goto yyL7;
  790.   }
  791.    return true;
  792. yyL7:;
  793.  
  794. # line 479 "Types.puma"
  795.   {
  796. # line 480 "Types.puma"
  797.    if (! (IsArrayOverlapped (t->TYPE_LIST.Next))) goto yyL8;
  798.   }
  799.    return true;
  800. yyL8:;
  801.  
  802.   break;
  803.   case kDYNAMIC:
  804. # line 483 "Types.puma"
  805.   {
  806. # line 484 "Types.puma"
  807.    if (! (((t->DYNAMIC.left_overlap > 0) || (t->DYNAMIC.right_overlap > 0)))) goto yyL9;
  808.   }
  809.    return true;
  810. yyL9:;
  811.  
  812.   break;
  813.   case kINDEX_TYPE:
  814. # line 487 "Types.puma"
  815.   {
  816. # line 488 "Types.puma"
  817.    if (! (((t->INDEX_TYPE.left_overlap > 0) || (t->INDEX_TYPE.right_overlap > 0)))) goto yyL10;
  818.   }
  819.    return true;
  820. yyL10:;
  821.  
  822.   break;
  823.   }
  824.  
  825.   return false;
  826. }
  827.  
  828. bool IsIntrFunc
  829. # if defined __STDC__ | defined __cplusplus
  830. (register tTree t)
  831. # else
  832. (t)
  833.  register tTree t;
  834. # endif
  835. {
  836. # line 499 "Types.puma"
  837.  
  838. tObject hobj;
  839.  
  840.   if (t == NoTree) return false;
  841.   if (t->Kind == kFUNC_CALL_EXP) {
  842. # line 503 "Types.puma"
  843.   {
  844. # line 504 "Types.puma"
  845.    if (! (IsIntrFunc (t->FUNC_CALL_EXP.FUNC_ID))) goto yyL1;
  846.   }
  847.    return true;
  848. yyL1:;
  849.  
  850.   }
  851.   if (t->Kind == kPROC_OBJ) {
  852. # line 507 "Types.puma"
  853.  {
  854.   tDefinitions hobj;
  855.   {
  856. # line 509 "Types.puma"
  857.  
  858. # line 511 "Types.puma"
  859.    hobj = GetDeclEntry (t->PROC_OBJ.Ident, GetIntrinsicEntries ());
  860. # line 513 "Types.puma"
  861.    if (! (hobj != NoObject)) goto yyL2;
  862.   {
  863. # line 514 "Types.puma"
  864.    if (! (hobj == t->PROC_OBJ.Object)) goto yyL2;
  865.   }
  866.   }
  867.    return true;
  868.  }
  869. yyL2:;
  870.  
  871.   }
  872.   return false;
  873. }
  874.  
  875. int VarRank
  876. # if defined __STDC__ | defined __cplusplus
  877. (register tDefinitions v)
  878. # else
  879. (v)
  880.  register tDefinitions v;
  881. # endif
  882. {
  883.   if (v->Kind == kVarObject) {
  884.   if (v->VarObject.decl->Kind == kVAR_DECL) {
  885. # line 525 "Types.puma"
  886.    return TreeRank (v->VarObject.decl->VAR_DECL.VAL);
  887.  
  888.   }
  889.   if (v->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  890. # line 529 "Types.puma"
  891.    return TreeRank (v->VarObject.decl->VAR_PARAM_DECL.VAL);
  892.  
  893.   }
  894.   if (v->VarObject.decl->Kind == kPARAMETER_DECL) {
  895. # line 533 "Types.puma"
  896.    return 0;
  897.  
  898.   }
  899. # line 541 "Types.puma"
  900.   {
  901. # line 542 "Types.puma"
  902.    printf ("Unknown VarObject for VarRank\n");
  903. # line 543 "Types.puma"
  904.    FileUnparse (stdout, v->VarObject.decl);
  905.   }
  906.    return 0;
  907.  
  908.   }
  909.   if (v->Kind == kTemplateObject) {
  910.   if (v->TemplateObject.decl->Kind == kTEMPLATE_DECL) {
  911. # line 537 "Types.puma"
  912.    return TreeRank (v->TemplateObject.decl->TEMPLATE_DECL.DIMENSIONS);
  913.  
  914.   }
  915.   }
  916.   if (v->Kind == kFuncObject) {
  917. # line 547 "Types.puma"
  918.    return 0;
  919.  
  920.   }
  921. # line 553 "Types.puma"
  922.   {
  923. # line 555 "Types.puma"
  924.    printf ("VarRank (module Types) failed\n");
  925. # line 556 "Types.puma"
  926.    SemFile = stdout;
  927. # line 557 "Types.puma"
  928.    ShowDeclarations (v);
  929. # line 558 "Types.puma"
  930.    exit (- 1);
  931.   }
  932.    return 0;
  933.  
  934. }
  935.  
  936. int TreeRank
  937. # if defined __STDC__ | defined __cplusplus
  938. (register tTree t)
  939. # else
  940. (t)
  941.  register tTree t;
  942. # endif
  943. {
  944. # line 571 "Types.puma"
  945.  
  946. int r1, r2, r3;
  947. tTree list;
  948. char string [100];
  949.  
  950.  
  951.   switch (t->Kind) {
  952.   case kVAR_DECL:
  953. # line 577 "Types.puma"
  954.    return TreeRank (t->VAR_DECL.VAL);
  955.  
  956.   case kVAR_PARAM_DECL:
  957. # line 581 "Types.puma"
  958.    return TreeRank (t->VAR_PARAM_DECL.VAL);
  959.  
  960.   case kPARAMETER_DECL:
  961. # line 585 "Types.puma"
  962.    return 0;
  963.  
  964.   case kDUMMY_TYPE:
  965. # line 589 "Types.puma"
  966.    return 0;
  967.  
  968.   case kINTEGER_TYPE:
  969. # line 593 "Types.puma"
  970.    return 0;
  971.  
  972.   case kREAL_TYPE:
  973. # line 597 "Types.puma"
  974.    return 0;
  975.  
  976.   case kBOOLEAN_TYPE:
  977. # line 601 "Types.puma"
  978.    return 0;
  979.  
  980.   case kCOMPLEX_TYPE:
  981. # line 605 "Types.puma"
  982.    return 0;
  983.  
  984.   case kSTRING_TYPE:
  985. # line 609 "Types.puma"
  986.    return 0;
  987.  
  988.   case kARRAY_TYPE:
  989. # line 614 "Types.puma"
  990.    return TreeListLength (t->ARRAY_TYPE.ARRAY_INDEX_TYPES);
  991.  
  992.   case kTYPE_LIST:
  993. # line 620 "Types.puma"
  994.    return TreeListLength (t);
  995.  
  996.   case kTYPE_EMPTY:
  997. # line 624 "Types.puma"
  998.    return 0;
  999.  
  1000.   case kTYPE_ID:
  1001. # line 628 "Types.puma"
  1002.    return 0;
  1003.  
  1004.   case kVAR_OBJ:
  1005. # line 632 "Types.puma"
  1006.    return VarRank (t->VAR_OBJ.Object);
  1007.  
  1008.   case kUSED_VAR:
  1009. # line 636 "Types.puma"
  1010.    return TreeRank (t->USED_VAR.VARNAME);
  1011.  
  1012.   case kSUBSTRING_VAR:
  1013. # line 640 "Types.puma"
  1014.    return TreeRank (t->SUBSTRING_VAR.IND_VAR);
  1015.  
  1016.   case kLOOP_VAR:
  1017. # line 644 "Types.puma"
  1018.    return 0;
  1019.  
  1020.   case kINDEXED_VAR:
  1021. # line 648 "Types.puma"
  1022.   {
  1023. # line 649 "Types.puma"
  1024.  r1 = TreeRank (t->INDEXED_VAR.IND_VAR);
  1025.       r2 = TreeListLength (t->INDEXED_VAR.IND_EXPS);
  1026.       if (r2 != r1)
  1027.          { printf ("Illegal indirect addressing\n");
  1028.            printf ("Rank of var = %d, no. of indexes = %d\n", r1, r2);
  1029.            FileUnparse (stdout, t);
  1030.            printf ("\n");
  1031.          }
  1032.       list = t->INDEXED_VAR.IND_EXPS;
  1033.       r2 = 0;
  1034.       while (list->Kind == kBTE_LIST)
  1035.          { r2 += TreeRank (list->BTE_LIST.Elem);
  1036.            list = list->BTE_LIST.Next;
  1037.          }
  1038.  
  1039.   }
  1040.    return r2;
  1041.  
  1042.   case kSELECTED_VAR:
  1043. # line 668 "Types.puma"
  1044.    return TreeRank (t->SELECTED_VAR.SELEC_VAR) + VarRank (t->SELECTED_VAR.SELECTOR->REC_COMP.Object);
  1045.  
  1046.   case kDO_VAR:
  1047. # line 672 "Types.puma"
  1048.    return 1;
  1049.  
  1050.   case kADDR:
  1051. # line 677 "Types.puma"
  1052.    return TreeRank (t->ADDR.E);
  1053.  
  1054.   case kDUMMY_EXP:
  1055. # line 681 "Types.puma"
  1056.    return 0;
  1057.  
  1058.   case kCONST_EXP:
  1059. # line 685 "Types.puma"
  1060.    return 0;
  1061.  
  1062.   case kARRAY_EXP:
  1063. # line 689 "Types.puma"
  1064.    return 1;
  1065.  
  1066.   case kSLICE_EXP:
  1067. # line 694 "Types.puma"
  1068.   {
  1069. # line 695 "Types.puma"
  1070.  r1 = TreeRank (t->SLICE_EXP.START);
  1071.       r2 = TreeRank (t->SLICE_EXP.STOP);
  1072.       r3 = TreeRank (t->SLICE_EXP.INC);
  1073.       if ( (r1 != 0) || (r2 != 0) || (r3 != 0) )
  1074.         { printf ("Illegal Rank in a slice expression\n");
  1075.           FileUnparse (stdout, t);
  1076.         }
  1077.  
  1078.   }
  1079.    return 1;
  1080.  
  1081.   case kOP_EXP:
  1082. # line 706 "Types.puma"
  1083.   {
  1084. # line 707 "Types.puma"
  1085.  r1 = TreeRank (t->OP_EXP.OPND1);
  1086.        r2 = TreeRank (t->OP_EXP.OPND2);
  1087.        if (r1 == 0)
  1088.           r1 = r2;
  1089.        else if (r2 == 0)
  1090.           r1 = r1;
  1091.        else if (r1 != r2)
  1092.           { printf ("Rank Error for binary expression\n");
  1093.             FileUnparse (stdout, t);
  1094.           }
  1095.  
  1096.   }
  1097.    return r1;
  1098.  
  1099.   case kOP1_EXP:
  1100. # line 721 "Types.puma"
  1101.    return TreeRank (t->OP1_EXP.OPND);
  1102.  
  1103.   case kVAR_EXP:
  1104. # line 725 "Types.puma"
  1105.    return TreeRank (t->VAR_EXP.V);
  1106.  
  1107.   case kFUNC_CALL_EXP:
  1108. # line 729 "Types.puma"
  1109.   {
  1110. # line 730 "Types.puma"
  1111.  if (IsIntrFunc (t))
  1112.          {
  1113.            if (IntrFuncKind1 (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident))
  1114.              { r1 = TreeListLength (t->FUNC_CALL_EXP.FUNC_PARAMS);
  1115.                if (r1 == 1)
  1116.                  r1 = TreeRank (t->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem);
  1117.                 else
  1118.                  printf ("Illegal ParamList for Intrinsic1\n");
  1119.              }
  1120.            else if (IntrFuncKind2 (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident))
  1121.              { r1 = ParameterRank (t->FUNC_CALL_EXP.FUNC_PARAMS); }
  1122.            else if (IntrFuncKindn (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident))
  1123.              { r1 = ParameterRank (t->FUNC_CALL_EXP.FUNC_PARAMS); }
  1124.            else
  1125.              { r1 = IntrFuncRank (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident, t->FUNC_CALL_EXP.FUNC_PARAMS);
  1126.                if (r1 < 0)
  1127.                 { printf ("Don't know rank of intrinsic function\n");
  1128.                   FileUnparse (stdout, t);
  1129.                 }
  1130.              }
  1131.          }
  1132.         else
  1133.          {
  1134.            r1 = 0;
  1135.          }
  1136.  
  1137.   }
  1138.    return r1;
  1139.  
  1140.   case kDO_EXP:
  1141. # line 759 "Types.puma"
  1142.    return 1;
  1143.  
  1144.   case kVAR_PARAM:
  1145. # line 764 "Types.puma"
  1146.    return TreeRank (t->VAR_PARAM.V);
  1147.  
  1148.   }
  1149.  
  1150. # line 768 "Types.puma"
  1151.   {
  1152. # line 769 "Types.puma"
  1153.    printf ("Tree Rank failed\n");
  1154. # line 770 "Types.puma"
  1155.    FileUnparse (stdout, t);
  1156. # line 771 "Types.puma"
  1157.    WriteTree (stdout, t);
  1158.   }
  1159.    return 0;
  1160.  
  1161. }
  1162.  
  1163. static int ParameterRank
  1164. # if defined __STDC__ | defined __cplusplus
  1165. (register tTree t)
  1166. # else
  1167. (t)
  1168.  register tTree t;
  1169. # endif
  1170. {
  1171. # line 783 "Types.puma"
  1172.  int h, h1, h2;
  1173.   if (t->Kind == kBTP_EMPTY) {
  1174. # line 793 "Types.puma"
  1175.    return 0;
  1176.  
  1177.   }
  1178.   if (t->Kind == kBTP_LIST) {
  1179. # line 797 "Types.puma"
  1180.   {
  1181. # line 798 "Types.puma"
  1182.  h2 = ParameterRank (t->BTP_LIST.Next);
  1183.       h1 = TreeRank (t->BTP_LIST.Elem);
  1184.       if (h1 != 0)
  1185.         { if ((h2 == 0) || (h1 == h2))
  1186.             h = h1;
  1187.            else
  1188.             h = -1;
  1189.         }
  1190.        else
  1191.          h = h2;
  1192.  
  1193.   }
  1194.    return h;
  1195.  
  1196.   }
  1197.  yyAbort ("ParameterRank");
  1198. }
  1199.  
  1200. int ParameterVars
  1201. # if defined __STDC__ | defined __cplusplus
  1202. (register tTree t)
  1203. # else
  1204. (t)
  1205.  register tTree t;
  1206. # endif
  1207. {
  1208. # line 820 "Types.puma"
  1209.  
  1210. int n;
  1211. char string [100];
  1212.  
  1213.  
  1214.   switch (t->Kind) {
  1215.   case kARRAY_TYPE:
  1216. # line 831 "Types.puma"
  1217.    return ParameterVars (t->ARRAY_TYPE.ARRAY_INDEX_TYPES);
  1218.  
  1219.   case kTYPE_LIST:
  1220. # line 835 "Types.puma"
  1221.    return ParameterVars (t->TYPE_LIST.Elem) + ParameterVars (t->TYPE_LIST.Next);
  1222.  
  1223.   case kTYPE_EMPTY:
  1224. # line 839 "Types.puma"
  1225.    return 0;
  1226.  
  1227.   case kINDEX_TYPE:
  1228. # line 843 "Types.puma"
  1229.    return ParameterVars (t->INDEX_TYPE.LOWER) + ParameterVars (t->INDEX_TYPE.UPPER);
  1230.  
  1231.   case kDYNAMIC:
  1232. # line 847 "Types.puma"
  1233.    return 0;
  1234.  
  1235.   case kVAR_OBJ:
  1236.   if (t->VAR_OBJ.Object->Kind == kVarObject) {
  1237.   if (t->VAR_OBJ.Object->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  1238. # line 857 "Types.puma"
  1239.    return 1;
  1240.  
  1241.   }
  1242.   }
  1243. # line 861 "Types.puma"
  1244.    return 0;
  1245.  
  1246.   case kUSED_VAR:
  1247. # line 866 "Types.puma"
  1248.    return ParameterVars (t->USED_VAR.VARNAME);
  1249.  
  1250.   case kLOOP_VAR:
  1251. # line 870 "Types.puma"
  1252.    return 0;
  1253.  
  1254.   case kINDEXED_VAR:
  1255. # line 874 "Types.puma"
  1256.    return ParameterVars (t->INDEXED_VAR.IND_VAR) + ParameterVars (t->INDEXED_VAR.IND_EXPS);
  1257.  
  1258.   case kADDR:
  1259. # line 878 "Types.puma"
  1260.    return ParameterVars (t->ADDR.E);
  1261.  
  1262.   case kDUMMY_EXP:
  1263. # line 882 "Types.puma"
  1264.    return 0;
  1265.  
  1266.   case kCONST_EXP:
  1267. # line 886 "Types.puma"
  1268.    return 0;
  1269.  
  1270.   case kARRAY_EXP:
  1271. # line 890 "Types.puma"
  1272.    return ParameterVars (t->ARRAY_EXP.ELEMENTS);
  1273.  
  1274.   case kSLICE_EXP:
  1275. # line 894 "Types.puma"
  1276.    return ParameterVars (t->SLICE_EXP.START) + ParameterVars (t->SLICE_EXP.STOP) + ParameterVars (t->SLICE_EXP.INC);
  1277.  
  1278.   case kOP_EXP:
  1279. # line 899 "Types.puma"
  1280.    return ParameterVars (t->OP_EXP.OPND1) + ParameterVars (t->OP_EXP.OPND2);
  1281.  
  1282.   case kOP1_EXP:
  1283. # line 903 "Types.puma"
  1284.    return ParameterVars (t->OP1_EXP.OPND);
  1285.  
  1286.   case kVAR_EXP:
  1287. # line 907 "Types.puma"
  1288.    return ParameterVars (t->VAR_EXP.V);
  1289.  
  1290.   case kFUNC_CALL_EXP:
  1291. # line 911 "Types.puma"
  1292.    return ParameterVars (t->FUNC_CALL_EXP.FUNC_PARAMS);
  1293.  
  1294.   case kDO_EXP:
  1295. # line 915 "Types.puma"
  1296.    return ParameterVars (t->DO_EXP.RANGE) + ParameterVars (t->DO_EXP.BODY);
  1297.  
  1298.   case kBTE_LIST:
  1299. # line 919 "Types.puma"
  1300.    return ParameterVars (t->BTE_LIST.Elem) + ParameterVars (t->BTE_LIST.Next);
  1301.  
  1302.   case kBTE_EMPTY:
  1303. # line 923 "Types.puma"
  1304.    return 0;
  1305.  
  1306.   case kBTP_LIST:
  1307. # line 927 "Types.puma"
  1308.    return ParameterVars (t->BTP_LIST.Elem) + ParameterVars (t->BTP_LIST.Next);
  1309.  
  1310.   case kBTP_EMPTY:
  1311. # line 931 "Types.puma"
  1312.    return 0;
  1313.  
  1314.   case kVAR_PARAM:
  1315. # line 935 "Types.puma"
  1316.    return ParameterVars (t->VAR_PARAM.V);
  1317.  
  1318.   }
  1319.  
  1320. # line 939 "Types.puma"
  1321.   {
  1322. # line 940 "Types.puma"
  1323.    printf ("Parameter Vars failed\n");
  1324. # line 941 "Types.puma"
  1325.    FileUnparse (stdout, t);
  1326. # line 942 "Types.puma"
  1327.    WriteTree (stdout, t);
  1328.   }
  1329.    return 0;
  1330.  
  1331. }
  1332.  
  1333. tTree VarType
  1334. # if defined __STDC__ | defined __cplusplus
  1335. (register tDefinitions v)
  1336. # else
  1337. (v)
  1338.  register tDefinitions v;
  1339. # endif
  1340. {
  1341.   if (v->Kind == kVarObject) {
  1342.   if (v->VarObject.decl->Kind == kVAR_DECL) {
  1343. # line 954 "Types.puma"
  1344.    return TreeType (v->VarObject.decl->VAR_DECL.VAL);
  1345.  
  1346.   }
  1347.   if (v->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  1348. # line 958 "Types.puma"
  1349.    return TreeType (v->VarObject.decl->VAR_PARAM_DECL.VAL);
  1350.  
  1351.   }
  1352. # line 962 "Types.puma"
  1353.   {
  1354. # line 963 "Types.puma"
  1355.    printf ("Unknown VarObject for VarType (no array !)\n");
  1356. # line 964 "Types.puma"
  1357.    FileUnparse (stdout, v->VarObject.decl);
  1358.   }
  1359.    return NoTree;
  1360.  
  1361.   }
  1362.  yyAbort ("VarType");
  1363. }
  1364.  
  1365. tTree TreeType
  1366. # if defined __STDC__ | defined __cplusplus
  1367. (register tTree t)
  1368. # else
  1369. (t)
  1370.  register tTree t;
  1371. # endif
  1372. {
  1373. # line 980 "Types.puma"
  1374.  
  1375. int r1, r2, r3;
  1376. tTree list;
  1377. tObject hobj;
  1378. char string[100];
  1379.  
  1380.  
  1381.   switch (t->Kind) {
  1382.   case kDUMMY_TYPE:
  1383. # line 987 "Types.puma"
  1384.    return t;
  1385.  
  1386.   case kINTEGER_TYPE:
  1387. # line 991 "Types.puma"
  1388.    return t;
  1389.  
  1390.   case kREAL_TYPE:
  1391. # line 995 "Types.puma"
  1392.    return t;
  1393.  
  1394.   case kBOOLEAN_TYPE:
  1395. # line 999 "Types.puma"
  1396.    return t;
  1397.  
  1398.   case kCOMPLEX_TYPE:
  1399. # line 1003 "Types.puma"
  1400.    return t;
  1401.  
  1402.   case kSTRING_TYPE:
  1403. # line 1007 "Types.puma"
  1404.    return t;
  1405.  
  1406.   case kTYPE_ID:
  1407. # line 1011 "Types.puma"
  1408.    return t;
  1409.  
  1410.   case kARRAY_TYPE:
  1411. # line 1015 "Types.puma"
  1412.    return TreeType (t->ARRAY_TYPE.ARRAY_COMP_TYPE);
  1413.  
  1414.   case kVAR_OBJ:
  1415. # line 1020 "Types.puma"
  1416.    return VarType (t->VAR_OBJ.Object);
  1417.  
  1418.   case kUSED_VAR:
  1419. # line 1024 "Types.puma"
  1420.    return TreeType (t->USED_VAR.VARNAME);
  1421.  
  1422.   case kLOOP_VAR:
  1423. # line 1028 "Types.puma"
  1424.    return TreeType (t->LOOP_VAR.LOOP_VARNAME);
  1425.  
  1426.   case kINDEXED_VAR:
  1427. # line 1032 "Types.puma"
  1428.    return TreeType (t->INDEXED_VAR.IND_VAR);
  1429.  
  1430.   }
  1431.  
  1432. # line 1036 "Types.puma"
  1433.   {
  1434. # line 1037 "Types.puma"
  1435.    printf ("Tree Type failed\n");
  1436. # line 1038 "Types.puma"
  1437.    FileUnparse (stdout, t);
  1438. # line 1039 "Types.puma"
  1439.    WriteTree (stdout, t);
  1440.   }
  1441.    return NoTree;
  1442.  
  1443. }
  1444.  
  1445. int VarSize
  1446. # if defined __STDC__ | defined __cplusplus
  1447. (register tDefinitions v)
  1448. # else
  1449. (v)
  1450.  register tDefinitions v;
  1451. # endif
  1452. {
  1453.   if (v->Kind == kVarObject) {
  1454.   if (v->VarObject.decl->Kind == kVAR_DECL) {
  1455. # line 1051 "Types.puma"
  1456.    return TreeSize (v->VarObject.decl->VAR_DECL.VAL);
  1457.  
  1458.   }
  1459.   if (v->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  1460. # line 1055 "Types.puma"
  1461.    return TreeSize (v->VarObject.decl->VAR_PARAM_DECL.VAL);
  1462.  
  1463.   }
  1464. # line 1059 "Types.puma"
  1465.   {
  1466. # line 1060 "Types.puma"
  1467.    printf ("Unknown VarObject for VarSize\n");
  1468. # line 1061 "Types.puma"
  1469.    FileUnparse (stdout, v->VarObject.decl);
  1470.   }
  1471.    return 0;
  1472.  
  1473.   }
  1474.  yyAbort ("VarSize");
  1475. }
  1476.  
  1477. int TreeSize
  1478. # if defined __STDC__ | defined __cplusplus
  1479. (register tTree t)
  1480. # else
  1481. (t)
  1482.  register tTree t;
  1483. # endif
  1484. {
  1485. # line 1073 "Types.puma"
  1486.  
  1487. int r1, r2, r3;
  1488. bool found;
  1489. tTree list;
  1490. tObject hobj;
  1491. char string[100];
  1492.  
  1493.  
  1494.   switch (t->Kind) {
  1495.   case kINTEGER_TYPE:
  1496. # line 1081 "Types.puma"
  1497.    return (t->INTEGER_TYPE.size);
  1498.  
  1499.   case kREAL_TYPE:
  1500. # line 1085 "Types.puma"
  1501.    return (t->REAL_TYPE.size);
  1502.  
  1503.   case kBOOLEAN_TYPE:
  1504. # line 1089 "Types.puma"
  1505.    return (t->BOOLEAN_TYPE.size);
  1506.  
  1507.   case kCOMPLEX_TYPE:
  1508. # line 1093 "Types.puma"
  1509.    return (t->COMPLEX_TYPE.size);
  1510.  
  1511.   case kSTRING_TYPE:
  1512. # line 1097 "Types.puma"
  1513.   {
  1514. # line 1098 "Types.puma"
  1515.  GetIntConstValue (t->STRING_TYPE.LENGTH, &found, &r1);
  1516.       if (!found)
  1517.         { r1 = 0;
  1518.           printf ("Tree Size failed for STRING-TYPE\n");
  1519.           FileUnparse (stdout, t);
  1520.         }
  1521.  
  1522.   }
  1523.    return r1;
  1524.  
  1525.   case kARRAY_TYPE:
  1526. # line 1108 "Types.puma"
  1527.    return TreeSize (t->ARRAY_TYPE.ARRAY_COMP_TYPE);
  1528.  
  1529.   case kVAR_OBJ:
  1530. # line 1112 "Types.puma"
  1531.    return VarSize (t->VAR_OBJ.Object);
  1532.  
  1533.   case kUSED_VAR:
  1534. # line 1116 "Types.puma"
  1535.    return TreeSize (t->USED_VAR.VARNAME);
  1536.  
  1537.   case kLOOP_VAR:
  1538. # line 1120 "Types.puma"
  1539.    return TreeSize (t->LOOP_VAR.LOOP_VARNAME);
  1540.  
  1541.   case kINDEXED_VAR:
  1542. # line 1124 "Types.puma"
  1543.    return TreeSize (t->INDEXED_VAR.IND_VAR);
  1544.  
  1545.   }
  1546.  
  1547. # line 1128 "Types.puma"
  1548.   {
  1549. # line 1129 "Types.puma"
  1550.    printf ("Tree Size failed\n");
  1551. # line 1130 "Types.puma"
  1552.    FileUnparse (stdout, t);
  1553. # line 1131 "Types.puma"
  1554.    WriteTree (stdout, t);
  1555.   }
  1556.    return 0;
  1557.  
  1558. }
  1559.  
  1560. static int IntrFuncRank
  1561. # if defined __STDC__ | defined __cplusplus
  1562. (register tIdent name, register tTree param)
  1563. # else
  1564. (name, param)
  1565.  register tIdent name;
  1566.  register tTree param;
  1567. # endif
  1568. {
  1569. # line 1146 "Types.puma"
  1570.   {
  1571. # line 1147 "Types.puma"
  1572.    if (! (IntrFuncRed (name) == true)) goto yyL1;
  1573.   }
  1574.    return IntrFuncRedRank (param);
  1575. yyL1:;
  1576.  
  1577.   if (equaltIdent (name, MakeIdent ("TRANSPOSE", 9))) {
  1578.   if (param->Kind == kBTP_LIST) {
  1579. # line 1151 "Types.puma"
  1580.    return TreeRank (param->BTP_LIST.Elem);
  1581.  
  1582.   }
  1583.   }
  1584.   if (equaltIdent (name, MakeIdent ("CSHIFT", 6))) {
  1585.   if (param->Kind == kBTP_LIST) {
  1586. # line 1155 "Types.puma"
  1587.    return TreeRank (param->BTP_LIST.Elem);
  1588.  
  1589.   }
  1590.   }
  1591.   if (equaltIdent (name, MakeIdent ("SPREAD", 6))) {
  1592.   if (param->Kind == kBTP_LIST) {
  1593. # line 1159 "Types.puma"
  1594.    return (TreeRank (param->BTP_LIST.Elem) + 1);
  1595.  
  1596.   }
  1597.   }
  1598.   if (equaltIdent (name, MakeIdent ("MERGE", 5))) {
  1599.   if (param->Kind == kBTP_LIST) {
  1600.   if (param->BTP_LIST.Next->Kind == kBTP_LIST) {
  1601.   if (param->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_LIST) {
  1602.   if (param->BTP_LIST.Next->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  1603. # line 1164 "Types.puma"
  1604.    return TreeRank (param->BTP_LIST.Elem);
  1605.  
  1606.   }
  1607.   }
  1608.   }
  1609.   }
  1610.   }
  1611. # line 1172 "Types.puma"
  1612.    return - 1;
  1613.  
  1614. }
  1615.  
  1616. static int IntrFuncRedRank
  1617. # if defined __STDC__ | defined __cplusplus
  1618. (register tTree param)
  1619. # else
  1620. (param)
  1621.  register tTree param;
  1622. # endif
  1623. {
  1624.   if (param->Kind == kBTP_LIST) {
  1625.   if (param->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  1626. # line 1186 "Types.puma"
  1627.    return 0;
  1628.  
  1629.   }
  1630.   if (param->BTP_LIST.Next->Kind == kBTP_LIST) {
  1631.   if (param->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  1632. # line 1190 "Types.puma"
  1633.    return (TreeRank (param->BTP_LIST.Elem) - 1);
  1634.  
  1635.   }
  1636.   }
  1637.   }
  1638. # line 1195 "Types.puma"
  1639.    return - 1;
  1640.  
  1641. }
  1642.  
  1643. bool IntrFuncKind1
  1644. # if defined __STDC__ | defined __cplusplus
  1645. (register tIdent name)
  1646. # else
  1647. (name)
  1648.  register tIdent name;
  1649. # endif
  1650. {
  1651.   if (equaltIdent (name, MakeIdent ("ABS", 3))) {
  1652. # line 1201 "Types.puma"
  1653.    return true;
  1654.  
  1655.   }
  1656.   if (equaltIdent (name, MakeIdent ("IABS", 4))) {
  1657. # line 1202 "Types.puma"
  1658.    return true;
  1659.  
  1660.   }
  1661.   if (equaltIdent (name, MakeIdent ("DABS", 4))) {
  1662. # line 1203 "Types.puma"
  1663.    return true;
  1664.  
  1665.   }
  1666.   if (equaltIdent (name, MakeIdent ("CABS", 4))) {
  1667. # line 1204 "Types.puma"
  1668.    return true;
  1669.  
  1670.   }
  1671.   if (equaltIdent (name, MakeIdent ("CDABS", 5))) {
  1672. # line 1205 "Types.puma"
  1673.    return true;
  1674.  
  1675.   }
  1676.   if (equaltIdent (name, MakeIdent ("AIMAG", 5))) {
  1677. # line 1207 "Types.puma"
  1678.    return true;
  1679.  
  1680.   }
  1681.   if (equaltIdent (name, MakeIdent ("DIMAG", 5))) {
  1682. # line 1208 "Types.puma"
  1683.    return true;
  1684.  
  1685.   }
  1686.   if (equaltIdent (name, MakeIdent ("ATAN", 4))) {
  1687. # line 1210 "Types.puma"
  1688.    return true;
  1689.  
  1690.   }
  1691.   if (equaltIdent (name, MakeIdent ("DATAN", 5))) {
  1692. # line 1211 "Types.puma"
  1693.    return true;
  1694.  
  1695.   }
  1696.   if (equaltIdent (name, MakeIdent ("CONJG", 5))) {
  1697. # line 1213 "Types.puma"
  1698.    return true;
  1699.  
  1700.   }
  1701.   if (equaltIdent (name, MakeIdent ("COS", 3))) {
  1702. # line 1215 "Types.puma"
  1703.    return true;
  1704.  
  1705.   }
  1706.   if (equaltIdent (name, MakeIdent ("CCOS", 4))) {
  1707. # line 1216 "Types.puma"
  1708.    return true;
  1709.  
  1710.   }
  1711.   if (equaltIdent (name, MakeIdent ("DCOS", 4))) {
  1712. # line 1217 "Types.puma"
  1713.    return true;
  1714.  
  1715.   }
  1716.   if (equaltIdent (name, MakeIdent ("CDCOS", 5))) {
  1717. # line 1218 "Types.puma"
  1718.    return true;
  1719.  
  1720.   }
  1721.   if (equaltIdent (name, MakeIdent ("ACOS", 4))) {
  1722. # line 1219 "Types.puma"
  1723.    return true;
  1724.  
  1725.   }
  1726.   if (equaltIdent (name, MakeIdent ("DACOS", 5))) {
  1727. # line 1220 "Types.puma"
  1728.    return true;
  1729.  
  1730.   }
  1731.   if (equaltIdent (name, MakeIdent ("COSH", 4))) {
  1732. # line 1222 "Types.puma"
  1733.    return true;
  1734.  
  1735.   }
  1736.   if (equaltIdent (name, MakeIdent ("DCOSH", 5))) {
  1737. # line 1223 "Types.puma"
  1738.    return true;
  1739.  
  1740.   }
  1741.   if (equaltIdent (name, MakeIdent ("EXP", 3))) {
  1742. # line 1225 "Types.puma"
  1743.    return true;
  1744.  
  1745.   }
  1746.   if (equaltIdent (name, MakeIdent ("DEXP", 4))) {
  1747. # line 1226 "Types.puma"
  1748.    return true;
  1749.  
  1750.   }
  1751.   if (equaltIdent (name, MakeIdent ("DBLE", 4))) {
  1752. # line 1228 "Types.puma"
  1753.    return true;
  1754.  
  1755.   }
  1756.   if (equaltIdent (name, MakeIdent ("FLOAT", 5))) {
  1757. # line 1229 "Types.puma"
  1758.    return true;
  1759.  
  1760.   }
  1761.   if (equaltIdent (name, MakeIdent ("DFLOAT", 6))) {
  1762. # line 1230 "Types.puma"
  1763.    return true;
  1764.  
  1765.   }
  1766.   if (equaltIdent (name, MakeIdent ("IFIX", 4))) {
  1767. # line 1231 "Types.puma"
  1768.    return true;
  1769.  
  1770.   }
  1771.   if (equaltIdent (name, MakeIdent ("ICHAR", 5))) {
  1772. # line 1233 "Types.puma"
  1773.    return true;
  1774.  
  1775.   }
  1776.   if (equaltIdent (name, MakeIdent ("CHAR", 4))) {
  1777. # line 1234 "Types.puma"
  1778.    return true;
  1779.  
  1780.   }
  1781.   if (equaltIdent (name, MakeIdent ("INT", 3))) {
  1782. # line 1236 "Types.puma"
  1783.    return true;
  1784.  
  1785.   }
  1786.   if (equaltIdent (name, MakeIdent ("NINT", 4))) {
  1787. # line 1237 "Types.puma"
  1788.    return true;
  1789.  
  1790.   }
  1791.   if (equaltIdent (name, MakeIdent ("IDINT", 5))) {
  1792. # line 1238 "Types.puma"
  1793.    return true;
  1794.  
  1795.   }
  1796.   if (equaltIdent (name, MakeIdent ("LOG", 3))) {
  1797. # line 1240 "Types.puma"
  1798.    return true;
  1799.  
  1800.   }
  1801.   if (equaltIdent (name, MakeIdent ("ALOG", 4))) {
  1802. # line 1241 "Types.puma"
  1803.    return true;
  1804.  
  1805.   }
  1806.   if (equaltIdent (name, MakeIdent ("CLOG", 4))) {
  1807. # line 1242 "Types.puma"
  1808.    return true;
  1809.  
  1810.   }
  1811.   if (equaltIdent (name, MakeIdent ("DLOG", 4))) {
  1812. # line 1243 "Types.puma"
  1813.    return true;
  1814.  
  1815.   }
  1816.   if (equaltIdent (name, MakeIdent ("CDLOG", 5))) {
  1817. # line 1244 "Types.puma"
  1818.    return true;
  1819.  
  1820.   }
  1821.   if (equaltIdent (name, MakeIdent ("LOG10", 5))) {
  1822. # line 1246 "Types.puma"
  1823.    return true;
  1824.  
  1825.   }
  1826.   if (equaltIdent (name, MakeIdent ("ALOG10", 6))) {
  1827. # line 1247 "Types.puma"
  1828.    return true;
  1829.  
  1830.   }
  1831.   if (equaltIdent (name, MakeIdent ("DLOG10", 6))) {
  1832. # line 1248 "Types.puma"
  1833.    return true;
  1834.  
  1835.   }
  1836.   if (equaltIdent (name, MakeIdent ("ODD", 3))) {
  1837. # line 1250 "Types.puma"
  1838.    return true;
  1839.  
  1840.   }
  1841.   if (equaltIdent (name, MakeIdent ("REAL", 4))) {
  1842. # line 1252 "Types.puma"
  1843.    return true;
  1844.  
  1845.   }
  1846.   if (equaltIdent (name, MakeIdent ("DREAL", 5))) {
  1847. # line 1253 "Types.puma"
  1848.    return true;
  1849.  
  1850.   }
  1851.   if (equaltIdent (name, MakeIdent ("ROUND", 5))) {
  1852. # line 1255 "Types.puma"
  1853.    return true;
  1854.  
  1855.   }
  1856.   if (equaltIdent (name, MakeIdent ("SIN", 3))) {
  1857. # line 1257 "Types.puma"
  1858.    return true;
  1859.  
  1860.   }
  1861.   if (equaltIdent (name, MakeIdent ("DSIN", 4))) {
  1862. # line 1258 "Types.puma"
  1863.    return true;
  1864.  
  1865.   }
  1866.   if (equaltIdent (name, MakeIdent ("CSIN", 4))) {
  1867. # line 1259 "Types.puma"
  1868.    return true;
  1869.  
  1870.   }
  1871.   if (equaltIdent (name, MakeIdent ("CDSIN", 5))) {
  1872. # line 1260 "Types.puma"
  1873.    return true;
  1874.  
  1875.   }
  1876.   if (equaltIdent (name, MakeIdent ("ASIN", 4))) {
  1877. # line 1261 "Types.puma"
  1878.    return true;
  1879.  
  1880.   }
  1881.   if (equaltIdent (name, MakeIdent ("DASIN", 5))) {
  1882. # line 1262 "Types.puma"
  1883.    return true;
  1884.  
  1885.   }
  1886.   if (equaltIdent (name, MakeIdent ("SINH", 4))) {
  1887. # line 1264 "Types.puma"
  1888.    return true;
  1889.  
  1890.   }
  1891.   if (equaltIdent (name, MakeIdent ("DSINH", 5))) {
  1892. # line 1265 "Types.puma"
  1893.    return true;
  1894.  
  1895.   }
  1896.   if (equaltIdent (name, MakeIdent ("SQR", 3))) {
  1897. # line 1267 "Types.puma"
  1898.    return true;
  1899.  
  1900.   }
  1901.   if (equaltIdent (name, MakeIdent ("SQRT", 4))) {
  1902. # line 1268 "Types.puma"
  1903.    return true;
  1904.  
  1905.   }
  1906.   if (equaltIdent (name, MakeIdent ("DSQRT", 5))) {
  1907. # line 1269 "Types.puma"
  1908.    return true;
  1909.  
  1910.   }
  1911.   if (equaltIdent (name, MakeIdent ("TAN", 3))) {
  1912. # line 1271 "Types.puma"
  1913.    return true;
  1914.  
  1915.   }
  1916.   if (equaltIdent (name, MakeIdent ("DTAN", 4))) {
  1917. # line 1272 "Types.puma"
  1918.    return true;
  1919.  
  1920.   }
  1921.   if (equaltIdent (name, MakeIdent ("TRUNC", 5))) {
  1922. # line 1274 "Types.puma"
  1923.    return true;
  1924.  
  1925.   }
  1926.   if (equaltIdent (name, MakeIdent ("NOT", 3))) {
  1927. # line 1276 "Types.puma"
  1928.    return true;
  1929.  
  1930.   }
  1931.   return false;
  1932. }
  1933.  
  1934. bool IntrFuncKind2
  1935. # if defined __STDC__ | defined __cplusplus
  1936. (register tIdent name)
  1937. # else
  1938. (name)
  1939.  register tIdent name;
  1940. # endif
  1941. {
  1942.   if (equaltIdent (name, MakeIdent ("SIGN", 4))) {
  1943. # line 1282 "Types.puma"
  1944.    return true;
  1945.  
  1946.   }
  1947.   if (equaltIdent (name, MakeIdent ("ISIGN", 5))) {
  1948. # line 1283 "Types.puma"
  1949.    return true;
  1950.  
  1951.   }
  1952.   if (equaltIdent (name, MakeIdent ("DSIGN", 5))) {
  1953. # line 1284 "Types.puma"
  1954.    return true;
  1955.  
  1956.   }
  1957.   if (equaltIdent (name, MakeIdent ("MOD", 3))) {
  1958. # line 1286 "Types.puma"
  1959.    return true;
  1960.  
  1961.   }
  1962.   if (equaltIdent (name, MakeIdent ("DMOD", 4))) {
  1963. # line 1287 "Types.puma"
  1964.    return true;
  1965.  
  1966.   }
  1967.   if (equaltIdent (name, MakeIdent ("AMOD", 4))) {
  1968. # line 1288 "Types.puma"
  1969.    return true;
  1970.  
  1971.   }
  1972.   if (equaltIdent (name, MakeIdent ("CMPLX", 5))) {
  1973. # line 1289 "Types.puma"
  1974.    return true;
  1975.  
  1976.   }
  1977.   if (equaltIdent (name, MakeIdent ("DCMPLX", 6))) {
  1978. # line 1290 "Types.puma"
  1979.    return true;
  1980.  
  1981.   }
  1982.   if (equaltIdent (name, MakeIdent ("LGT", 3))) {
  1983. # line 1292 "Types.puma"
  1984.    return true;
  1985.  
  1986.   }
  1987.   if (equaltIdent (name, MakeIdent ("LGE", 3))) {
  1988. # line 1293 "Types.puma"
  1989.    return true;
  1990.  
  1991.   }
  1992.   if (equaltIdent (name, MakeIdent ("LLT", 3))) {
  1993. # line 1294 "Types.puma"
  1994.    return true;
  1995.  
  1996.   }
  1997.   if (equaltIdent (name, MakeIdent ("LLE", 3))) {
  1998. # line 1295 "Types.puma"
  1999.    return true;
  2000.  
  2001.   }
  2002.   if (equaltIdent (name, MakeIdent ("ATAN2", 5))) {
  2003. # line 1297 "Types.puma"
  2004.    return true;
  2005.  
  2006.   }
  2007.   if (equaltIdent (name, MakeIdent ("DATAN2", 6))) {
  2008. # line 1298 "Types.puma"
  2009.    return true;
  2010.  
  2011.   }
  2012.   return false;
  2013. }
  2014.  
  2015. bool IntrFuncKindn
  2016. # if defined __STDC__ | defined __cplusplus
  2017. (register tIdent name)
  2018. # else
  2019. (name)
  2020.  register tIdent name;
  2021. # endif
  2022. {
  2023.   if (equaltIdent (name, MakeIdent ("MIN", 3))) {
  2024. # line 1302 "Types.puma"
  2025.    return true;
  2026.  
  2027.   }
  2028.   if (equaltIdent (name, MakeIdent ("MIN0", 4))) {
  2029. # line 1303 "Types.puma"
  2030.    return true;
  2031.  
  2032.   }
  2033.   if (equaltIdent (name, MakeIdent ("AMIN1", 5))) {
  2034. # line 1304 "Types.puma"
  2035.    return true;
  2036.  
  2037.   }
  2038.   if (equaltIdent (name, MakeIdent ("DMIN1", 5))) {
  2039. # line 1305 "Types.puma"
  2040.    return true;
  2041.  
  2042.   }
  2043.   if (equaltIdent (name, MakeIdent ("MAX", 3))) {
  2044. # line 1307 "Types.puma"
  2045.    return true;
  2046.  
  2047.   }
  2048.   if (equaltIdent (name, MakeIdent ("MAX0", 4))) {
  2049. # line 1308 "Types.puma"
  2050.    return true;
  2051.  
  2052.   }
  2053.   if (equaltIdent (name, MakeIdent ("AMAX1", 5))) {
  2054. # line 1309 "Types.puma"
  2055.    return true;
  2056.  
  2057.   }
  2058.   if (equaltIdent (name, MakeIdent ("DMAX1", 5))) {
  2059. # line 1310 "Types.puma"
  2060.    return true;
  2061.  
  2062.   }
  2063.   if (equaltIdent (name, MakeIdent ("IBSET", 5))) {
  2064. # line 1312 "Types.puma"
  2065.    return true;
  2066.  
  2067.   }
  2068.   if (equaltIdent (name, MakeIdent ("IBCLR", 5))) {
  2069. # line 1313 "Types.puma"
  2070.    return true;
  2071.  
  2072.   }
  2073.   if (equaltIdent (name, MakeIdent ("IAND", 4))) {
  2074. # line 1314 "Types.puma"
  2075.    return true;
  2076.  
  2077.   }
  2078.   if (equaltIdent (name, MakeIdent ("IOR", 3))) {
  2079. # line 1315 "Types.puma"
  2080.    return true;
  2081.  
  2082.   }
  2083.   if (equaltIdent (name, MakeIdent ("IEOR", 4))) {
  2084. # line 1316 "Types.puma"
  2085.    return true;
  2086.  
  2087.   }
  2088.   if (equaltIdent (name, MakeIdent ("ISHFT", 5))) {
  2089. # line 1317 "Types.puma"
  2090.    return true;
  2091.  
  2092.   }
  2093.   if (equaltIdent (name, MakeIdent ("ISHFTC", 6))) {
  2094. # line 1318 "Types.puma"
  2095.    return true;
  2096.  
  2097.   }
  2098.   if (equaltIdent (name, MakeIdent ("BTEST", 5))) {
  2099. # line 1320 "Types.puma"
  2100.    return true;
  2101.  
  2102.   }
  2103.   return false;
  2104. }
  2105.  
  2106. bool IntrFuncRed
  2107. # if defined __STDC__ | defined __cplusplus
  2108. (register tIdent name)
  2109. # else
  2110. (name)
  2111.  register tIdent name;
  2112. # endif
  2113. {
  2114.   if (equaltIdent (name, MakeIdent ("MINVAL", 6))) {
  2115. # line 1326 "Types.puma"
  2116.    return true;
  2117.  
  2118.   }
  2119.   if (equaltIdent (name, MakeIdent ("MAXVAL", 6))) {
  2120. # line 1327 "Types.puma"
  2121.    return true;
  2122.  
  2123.   }
  2124.   if (equaltIdent (name, MakeIdent ("SUM", 3))) {
  2125. # line 1328 "Types.puma"
  2126.    return true;
  2127.  
  2128.   }
  2129.   if (equaltIdent (name, MakeIdent ("PRODUCT", 7))) {
  2130. # line 1329 "Types.puma"
  2131.    return true;
  2132.  
  2133.   }
  2134.   if (equaltIdent (name, MakeIdent ("COUNT", 5))) {
  2135. # line 1330 "Types.puma"
  2136.    return true;
  2137.  
  2138.   }
  2139.   if (equaltIdent (name, MakeIdent ("ANY", 3))) {
  2140. # line 1331 "Types.puma"
  2141.    return true;
  2142.  
  2143.   }
  2144.   if (equaltIdent (name, MakeIdent ("ALL", 3))) {
  2145. # line 1332 "Types.puma"
  2146.    return true;
  2147.  
  2148.   }
  2149.   if (equaltIdent (name, MakeIdent ("IALL", 4))) {
  2150. # line 1334 "Types.puma"
  2151.    return true;
  2152.  
  2153.   }
  2154.   if (equaltIdent (name, MakeIdent ("IANY", 4))) {
  2155. # line 1335 "Types.puma"
  2156.    return true;
  2157.  
  2158.   }
  2159.   if (equaltIdent (name, MakeIdent ("IPARITY", 7))) {
  2160. # line 1336 "Types.puma"
  2161.    return true;
  2162.  
  2163.   }
  2164.   if (equaltIdent (name, MakeIdent ("PARITY", 6))) {
  2165. # line 1337 "Types.puma"
  2166.    return true;
  2167.  
  2168.   }
  2169.   return false;
  2170. }
  2171.  
  2172. tTree ArrayCompType
  2173. # if defined __STDC__ | defined __cplusplus
  2174. (register tDefinitions v)
  2175. # else
  2176. (v)
  2177.  register tDefinitions v;
  2178. # endif
  2179. {
  2180.   if (v->Kind == kVarObject) {
  2181.   if (v->VarObject.decl->Kind == kVAR_DECL) {
  2182.   if (v->VarObject.decl->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  2183. # line 1347 "Types.puma"
  2184.    return v->VarObject.decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_COMP_TYPE;
  2185.  
  2186.   }
  2187.   }
  2188.   if (v->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  2189.   if (v->VarObject.decl->VAR_PARAM_DECL.VAL->Kind == kARRAY_TYPE) {
  2190. # line 1351 "Types.puma"
  2191.    return v->VarObject.decl->VAR_PARAM_DECL.VAL->ARRAY_TYPE.ARRAY_COMP_TYPE;
  2192.  
  2193.   }
  2194.   }
  2195. # line 1355 "Types.puma"
  2196.   {
  2197. # line 1356 "Types.puma"
  2198.    printf ("Unknown VarObject for ArrayCompType\n");
  2199. # line 1357 "Types.puma"
  2200.    WriteTree (stdout, v->VarObject.decl);
  2201. # line 1358 "Types.puma"
  2202.    kill_in_protocol ();
  2203.   }
  2204.    return NoTree;
  2205.  
  2206.   }
  2207.  yyAbort ("ArrayCompType");
  2208. }
  2209.  
  2210. tTree ArrayFormals
  2211. # if defined __STDC__ | defined __cplusplus
  2212. (register tDefinitions v)
  2213. # else
  2214. (v)
  2215.  register tDefinitions v;
  2216. # endif
  2217. {
  2218.   if (v->Kind == kVarObject) {
  2219.   if (v->VarObject.decl->Kind == kVAR_DECL) {
  2220.   if (v->VarObject.decl->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  2221. # line 1370 "Types.puma"
  2222.    return v->VarObject.decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES;
  2223.  
  2224.   }
  2225.   }
  2226.   if (v->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  2227.   if (v->VarObject.decl->VAR_PARAM_DECL.VAL->Kind == kARRAY_TYPE) {
  2228. # line 1374 "Types.puma"
  2229.    return v->VarObject.decl->VAR_PARAM_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES;
  2230.  
  2231.   }
  2232.   }
  2233.   }
  2234. # line 1378 "Types.puma"
  2235.   {
  2236. # line 1379 "Types.puma"
  2237.    printf ("Illegal Object for ArrayFormals\n");
  2238. # line 1380 "Types.puma"
  2239.    obj_error_protocol ("illegal object for ArrayFormals", v);
  2240. # line 1381 "Types.puma"
  2241.    kill_in_protocol ();
  2242.   }
  2243.    return NoTree;
  2244.  
  2245. }
  2246.  
  2247. static bool IsConstExp
  2248. # if defined __STDC__ | defined __cplusplus
  2249. (register tTree t)
  2250. # else
  2251. (t)
  2252.  register tTree t;
  2253. # endif
  2254. {
  2255.   if (t == NoTree) return false;
  2256.   if (t->Kind == kCONST_EXP) {
  2257. # line 1393 "Types.puma"
  2258.    return true;
  2259.  
  2260.   }
  2261.   if (t->Kind == kARRAY_EXP) {
  2262. # line 1395 "Types.puma"
  2263.   {
  2264. # line 1396 "Types.puma"
  2265.    if (! (IsConstExp (t->ARRAY_EXP.ELEMENTS))) goto yyL2;
  2266.   }
  2267.    return true;
  2268. yyL2:;
  2269.  
  2270.   }
  2271.   if (t->Kind == kSLICE_EXP) {
  2272. # line 1399 "Types.puma"
  2273.   {
  2274. # line 1400 "Types.puma"
  2275.    if (! (IsConstExp (t->SLICE_EXP.START))) goto yyL3;
  2276.   {
  2277. # line 1401 "Types.puma"
  2278.    if (! (IsConstExp (t->SLICE_EXP.STOP))) goto yyL3;
  2279.   {
  2280. # line 1402 "Types.puma"
  2281.    if (! (IsConstExp (t->SLICE_EXP.INC))) goto yyL3;
  2282.   }
  2283.   }
  2284.   }
  2285.    return true;
  2286. yyL3:;
  2287.  
  2288.   }
  2289.   if (t->Kind == kOP_EXP) {
  2290. # line 1405 "Types.puma"
  2291.   {
  2292. # line 1406 "Types.puma"
  2293.    if (! (IsConstExp (t->OP_EXP.OPND1))) goto yyL4;
  2294.   {
  2295. # line 1407 "Types.puma"
  2296.    if (! (IsConstExp (t->OP_EXP.OPND2))) goto yyL4;
  2297.   }
  2298.   }
  2299.    return true;
  2300. yyL4:;
  2301.  
  2302.   }
  2303.   if (t->Kind == kOP1_EXP) {
  2304. # line 1410 "Types.puma"
  2305.   {
  2306. # line 1411 "Types.puma"
  2307.    if (! (IsConstExp (t->OP1_EXP.OPND))) goto yyL5;
  2308.   }
  2309.    return true;
  2310. yyL5:;
  2311.  
  2312.   }
  2313.   if (t->Kind == kVAR_EXP) {
  2314.   if (t->VAR_EXP.V->Kind == kUSED_VAR) {
  2315.   if (t->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Object->Kind == kVarObject) {
  2316.   if (t->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Object->VarObject.Kind->Kind == kVarConstant) {
  2317. # line 1414 "Types.puma"
  2318.   {
  2319. # line 1416 "Types.puma"
  2320.    if (! (IsConstExp (t->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Object->VarObject.Kind->VarConstant.Val))) goto yyL6;
  2321.   }
  2322.    return true;
  2323. yyL6:;
  2324.  
  2325.   }
  2326.   }
  2327.   }
  2328.   }
  2329.   return false;
  2330. }
  2331.  
  2332. tIdent TreeVarName
  2333. # if defined __STDC__ | defined __cplusplus
  2334. (register tTree var)
  2335. # else
  2336. (var)
  2337.  register tTree var;
  2338. # endif
  2339. {
  2340.   if (var->Kind == kVAR_OBJ) {
  2341. # line 1427 "Types.puma"
  2342.    return var->VAR_OBJ.Ident;
  2343.  
  2344.   }
  2345.   if (var->Kind == kUSED_VAR) {
  2346. # line 1431 "Types.puma"
  2347.    return TreeVarName (var->USED_VAR.VARNAME);
  2348.  
  2349.   }
  2350.   if (var->Kind == kLOOP_VAR) {
  2351. # line 1435 "Types.puma"
  2352.    return TreeVarName (var->LOOP_VAR.LOOP_VARNAME);
  2353.  
  2354.   }
  2355.   if (var->Kind == kVAR_EXP) {
  2356. # line 1439 "Types.puma"
  2357.    return TreeVarName (var->VAR_EXP.V);
  2358.  
  2359.   }
  2360.   if (var->Kind == kINDEXED_VAR) {
  2361. # line 1443 "Types.puma"
  2362.    return TreeVarName (var->INDEXED_VAR.IND_VAR);
  2363.  
  2364.   }
  2365. # line 1447 "Types.puma"
  2366.   {
  2367. # line 1448 "Types.puma"
  2368.    printf ("Unknown Tree in TreeVarName\n");
  2369. # line 1449 "Types.puma"
  2370.    FileUnparse (stdout, var);
  2371. # line 1450 "Types.puma"
  2372.    WriteTree (stdout, var);
  2373.   }
  2374.    return MakeIdent ("", 0);
  2375.  
  2376. }
  2377.  
  2378. tTree LastIndex
  2379. # if defined __STDC__ | defined __cplusplus
  2380. (register tTree t)
  2381. # else
  2382. (t)
  2383.  register tTree t;
  2384. # endif
  2385. {
  2386.   if (t->Kind == kBTE_LIST) {
  2387.   if (t->BTE_LIST.Next->Kind == kBTE_EMPTY) {
  2388. # line 1462 "Types.puma"
  2389.    return t->BTE_LIST.Elem;
  2390.  
  2391.   }
  2392. # line 1466 "Types.puma"
  2393.    return LastIndex (t->BTE_LIST.Next);
  2394.  
  2395.   }
  2396.   if (t->Kind == kTYPE_LIST) {
  2397.   if (t->TYPE_LIST.Next->Kind == kTYPE_EMPTY) {
  2398. # line 1470 "Types.puma"
  2399.    return t->TYPE_LIST.Elem;
  2400.  
  2401.   }
  2402. # line 1474 "Types.puma"
  2403.    return LastIndex (t->TYPE_LIST.Next);
  2404.  
  2405.   }
  2406.  yyAbort ("LastIndex");
  2407. }
  2408.  
  2409. void BeginTypes ()
  2410. {
  2411. }
  2412.  
  2413. void CloseTypes ()
  2414. {
  2415. }
  2416.